home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_100 / 122_01 / pist2d.c < prev    next >
Text File  |  1984-03-05  |  5KB  |  254 lines
  1. /*********************************************************/
  2. /*                             */
  3. /* PISTOL-Portably Implemented Stack Oriented Language     */
  4. /*            Version 2.0             */
  5. /* (C) 1983 by    Ernest E. Bergmann             */
  6. /*        Physics, Building #16             */
  7. /*        Lehigh Univerisity             */
  8. /*        Bethlehem, Pa. 18015             */
  9. /*                             */
  10. /* Permission is hereby granted for all reproduction and */
  11. /* distribution of this material provided this notice is */
  12. /* included.                         */
  13. /*                             */
  14. /*********************************************************/
  15. /* fifth code module for PISTOL v2.0 in BDS 'C' v1.45a */
  16. /* September 5, 1982 */
  17. #include "bdscio.h"
  18. #include "pistol.h"
  19. /* continuation of interpreter primitives */
  20.  
  21. beginop()
  22. { pushck('B'); push(ram[1].in); }
  23.  
  24. endop()
  25. {    if(strings[1+strings[1]]=='B')
  26.         {dropck(); compile(PIF);
  27.         compile(pop()-ram[1].in);
  28.         }
  29.     else synterr();
  30. }
  31.  
  32. repet()
  33. {    Pc=&strings[1]+strings[1];Pc2=Pc-1;
  34.     dropck();dropck();
  35.     if((*Pc=='F') && (*Pc2=='B'))
  36.         {compile(PELSE);
  37.         compile(stack[stkptr-1]-ram[1].in);
  38.         touchup(); pop();
  39.         }
  40.     else synterr();
  41. }
  42.  
  43. pdollar()
  44. {    enter(); Pw=ip;
  45.     push(ip+W);push(ram[2].pw);push(*Pw-W);
  46.     move();
  47.     Pw=ip;ram[2].in += *Pw-W;
  48.     push(ram[2].in-W);
  49.     fenter();
  50.     Pw=ram[5].pw;Pw=*Pw;Pw--;
  51.     *Pw=COMPME;
  52.     permstrings();
  53.     Pw=ip;ip += *Pw;
  54. }
  55.  
  56. pcolon()
  57. {    enter(); Pw=ip;
  58.     push(ip+W);push(ram[2].pw);push(*Pw-W);
  59.     move();
  60.     Pw=ip;ram[2].in += *Pw-W;
  61.     push(ram[2].in-W);
  62.     fenter();
  63.     permstrings(); Pw=ip;
  64.     ip += *Pw;
  65. }
  66.  
  67. casat()
  68. {    tos=pop();
  69.     if(cptr<tos) abort();
  70.     push(cstack[cptr-tos]);
  71. }
  72.  
  73. pploop()
  74. { lstack[lptr]+=pop(); aloop(); }
  75.  
  76. plloop()
  77. {    if(strings[1+strings[1]]=='D')
  78.         {dropck(); compile(PPLOOP);
  79.         compile(stack[stkptr]-ram[1].in+W);
  80.         touchup();
  81.         }
  82.     else synterr();
  83. }
  84.  
  85. cat()
  86. {    Pc=pop();
  87.     if((Pc<&strings)||(Pc>&strings[STRINGSSIZE]))
  88.         merr(readv);
  89.     push(*Pc);
  90. }
  91.  
  92. cstore()
  93. {    Pc=pop();
  94.     if((Pc<&strings)||(Pc>&strings[STRINGSSIZE]))
  95.         merr(readv);
  96.     *Pc=pop();
  97. }
  98.  
  99. ploop()
  100. { lstack[lptr]++;aloop(); }
  101.  
  102. dotdot()
  103. {/* int tos,ntt,param; */
  104.     tos=pop();ntt=pop();param=pop();
  105.     if(ntt<=tos)
  106.         {if((ntt<=param)&&(param<=tos)) push(TRU);
  107.          else push(FALS);
  108.         }
  109.     else    {if((ntt<=param)||(param<=tos)) push(TRU);
  110.          else push(FALS);
  111.         }
  112. }
  113.  
  114. semidol()
  115. {    if(strings[1+strings[1]]=='$')
  116.         {dropck(); compile(PSEMICOLON);
  117.         touchup();
  118.         }
  119.     else synterr();
  120. }
  121.  
  122. primq()
  123. {    tos=pop();
  124.     if((tos<0)||(tos>=NFUNCS)) push(FALS);
  125.     else push(TRU);
  126. }
  127.  
  128. cordmp()
  129. {    fname(imagename);
  130.     temp=creat(imagename);
  131.     if(temp==ERROR) merr(nopen);
  132.     write(temp,nram,NSAVE);
  133.     close(temp);
  134. }
  135.  
  136. restor()
  137. {    fname(imagename);
  138.     temp=open(imagename,0);
  139.     if(temp==ERROR) merr(nopen);
  140.     read(temp,nram,NSAVE);
  141. }
  142.  
  143. sat()
  144. {    tos=pop();
  145.     temp=stkptr-tos;
  146.     if((tos<0)||(temp<=0)) merr(readv);
  147.     else push(stack[temp]);
  148. }
  149.  
  150. listfil()
  151. { rewrit(listname,list); }
  152.  
  153. rewrit(name,iobuf)
  154. char name[NAMESIZE],*iobuf;
  155. {    if(stkptr<1)merr(undflo);
  156.     if(name[0])
  157.         {if(ram[20].in) carret();
  158.         message(redef);printf(name);carret();
  159.         closout(iobuf);
  160.         }
  161.     fname(name);
  162.     if(0>fcreat(name,iobuf))
  163.     {    if(ram[20].in) carret();
  164.         printf(name);
  165.         merr(nopen);
  166.     }
  167. }
  168.  
  169. lat()
  170. {    tos=pop();
  171.     if((lptr<tos)||(lptr<0)) merr(readv);
  172.     push(lstack[lptr-tos]);
  173. }
  174.  
  175. ofcas()
  176. { pushck('C'); compile(POFCAS);    fwdref(); }
  177.  
  178. ccolon()
  179. {    if(strings[1+strings[1]]=='C')
  180.         {pushck('c');compile(PCCOL);fwdref();}
  181.     else synterr();
  182. }
  183.  
  184. semicc()
  185. {    if(strings[1+strings[1]]=='c')
  186.         {dropck();compile(PSEMICC);touchup();}
  187.     else synterr();
  188. }
  189.  
  190. ndcas()
  191. {    if(strings[1+strings[1]]=='C')
  192.         {dropck();compile(ram[21].in);touchup();}
  193.     else synterr();
  194. }
  195.  
  196. pofcas()
  197. {    if(stkptr<1) merr(undflo);
  198.     Pw=ip; cpush(ip+ *Pw);
  199.     cpush(stack[stkptr]);
  200.     ip += W;
  201. }
  202.  
  203. pccol()
  204. {    if(pop()) ip += W;
  205.     else    {push(cstack[cptr]);
  206.         Pw=ip; ip += *Pw;
  207.         }
  208. }
  209.  
  210. psemicc()
  211. {    cptr -= 2;
  212.     if(cptr<0) abort();
  213.     ip=cstack[cptr+1];
  214. }
  215.  
  216. openr()
  217. {    fname(namein);
  218.     if(fopen(namein,edin)==ERROR)
  219.         {printf("\nCAN'T OPEN:%s",namein);abort();}
  220.     ram[26].in=0;
  221. }
  222.  
  223. openw()
  224. {    rewrit(namout,edout);
  225.     ram[27].in=0;
  226. }
  227.  
  228. readl()
  229. {int c;
  230.     ram[12].in=0;
  231.     ram[13].pc=&strings[1+LINEBUF];
  232.     if(ram[26].in<0) merr(feof);
  233.     finline(edin,&ram[26].in);
  234.     ram[26].in++;
  235.     c=getc(edin);
  236.     if((c == ERROR) || (c== CPMEOF))
  237.          ram[26].in=-ram[26].in;
  238.     ungetc(c,edin);
  239.     if(ram[9].in) message(&strings[LINEBUF]);
  240. }
  241.  
  242. writl()
  243. {    if(ram[27].in>0) merr(nopen);
  244.     Pc=pop(); Pc2=Pc+*Pc-1;
  245.     while(Pc<Pc2) {Pc++;putc(*Pc,edout);}
  246.     fprintf(edout,"\n");/*CPM newline*/
  247.     ram[27].in--;
  248. }
  249. 
  250. }
  251.  
  252. ndcas()
  253. {    if(strings[1+strings[1]]=='C')
  254.